home *** CD-ROM | disk | FTP | other *** search
/ Gekkan Dennou Club 147 / Gekkan Dennou Club - 2000.8 Vol. 147 (Japan).7z / Gekkan Dennou Club - 2000.8 Vol. 147 (Japan) (Track 1).bin / docs / perl / monarray.pl next >
Perl Script  |  2000-06-25  |  1KB  |  65 lines
  1. # タイを使った配列の監視
  2. package MonArray;
  3.  
  4. sub TIEARRAY {
  5.     my ($pkg, $name, $ra) = @_;
  6.     my $obj = {
  7.     name => $name, array => [@$ra],
  8.     };
  9.     bless $obj, $pkg;
  10.     $obj;
  11. }
  12.  
  13. sub FETCH {
  14.     my ($obj, $index) = @_;
  15.     my $value = $obj->{'array'}->[$index];
  16.     print 'Read : $',$obj->{'name'}, "[$index] -> $value\n";
  17.     $value;
  18. }
  19.  
  20. sub STORE {
  21.     my ($obj, $index, $new_value) = @_;
  22.     print 'Write : $',$obj->{'name'}, "[$index] <- $new_value\n";
  23.     $obj->{'array'}->[$index] = $new_value;
  24. }
  25.  
  26. sub DESTROY {
  27.     my $obj = shift;
  28.     if( $obj->{'name'} ne '__UNMONITOR__' ){
  29.     print 'DESTORY @', "$obj->{'name'}\n";
  30.     }
  31. }
  32.  
  33. sub unmonitor {
  34.     my ($pkg, $rvar) = @_;
  35.     my $last_array;
  36.     {
  37.     my $obj = tied @$rvar;
  38.     $last_array = $obj->{'array'};
  39.     $obj->{'name'} = '__UNMONITOR__'
  40.     }
  41.     untie @$rvar;
  42.     @$rvar = @$last_array;
  43. }
  44.  
  45.  
  46. package main;
  47.  
  48. @a = (10, 20, 30);
  49. tie @a, 'MonArray', 'a', \@a;
  50.  
  51. $x = $a[1];
  52. print "x = $x\n";
  53.  
  54. $a[1] = 200;
  55.  
  56. $y = $a[1];
  57. print "y = $y\n";
  58.  
  59. MonArray->unmonitor( \@a );
  60.  
  61. print "@a\n";
  62.  
  63. # end of file
  64.  
  65.